home *** CD-ROM | disk | FTP | other *** search
/ isnet Internet / Isnet Internet CD.iso / prog / hiz / 09 / 09.exe / adynware.exe / perl / lib / Text / Wrap.pm < prev   
Encoding:
Perl POD Document  |  1999-12-28  |  2.9 KB  |  138 lines
  1. package Text::Wrap;
  2.  
  3. require Exporter;
  4.  
  5. @ISA = (Exporter);
  6. @EXPORT = qw(wrap);
  7. @EXPORT_OK = qw($columns);
  8.  
  9. $VERSION = 97.011701;
  10.  
  11. use vars qw($VERSION $columns $debug);
  12. use strict;
  13.  
  14. BEGIN    {
  15.     $columns = 76;  # <= screen width
  16.     $debug = 0;
  17. }
  18.  
  19. use Text::Tabs qw(expand unexpand);
  20.  
  21. sub wrap
  22. {
  23.     my ($ip, $xp, @t) = @_;
  24.  
  25.     my $r = "";
  26.     my $t = expand(join(" ",@t));
  27.     my $lead = $ip;
  28.     my $ll = $columns - length(expand($lead)) - 1;
  29.     my $nl = "";
  30.  
  31.  
  32.     if ($t =~ s/^([^\n]{0,$ll})(\s|\Z(?!\n))//xm) {
  33.  
  34.         $r .= unexpand($lead . $1);
  35.  
  36.         $lead = $xp;
  37.         $ll = $columns - length(expand($lead)) - 1;
  38.         $nl = $2;
  39.  
  40.         while ($t) {
  41.             if ( $t =~ s/^([^\n]{0,$ll})(\s|\Z(?!\n))//xm ) {
  42.                 print "\$2 is '$2'\n" if $debug;
  43.                 $nl = $2;
  44.                 $r .= unexpand("\n" . $lead . $1);
  45.             } elsif ($t =~ s/^([^\n]{$ll})//) {
  46.                 $nl = "\n";
  47.                 $r .= unexpand("\n" . $lead . $1);
  48.             }
  49.         }
  50.         $r .= $nl;
  51.     } 
  52.  
  53.     die "couldn't wrap '$t'" 
  54.         if length($t) > $ll;
  55.  
  56.     print "-----------$r---------\n" if $debug;
  57.  
  58.     print "Finish up with '$lead', '$t'\n" if $debug;
  59.  
  60.     $r .= $lead . $t if $t ne "";
  61.  
  62.     print "-----------$r---------\n" if $debug;;
  63.     return $r;
  64. }
  65.  
  66. 1;
  67. __END__
  68.  
  69. =head1 NAME
  70.  
  71. Text::Wrap - line wrapping to form simple paragraphs
  72.  
  73. =head1 SYNOPSIS 
  74.  
  75.     use Text::Wrap
  76.  
  77.     print wrap($initial_tab, $subsequent_tab, @text);
  78.  
  79.     use Text::Wrap qw(wrap $columns);
  80.  
  81.     $columns = 132;
  82.  
  83. =head1 DESCRIPTION
  84.  
  85. Text::Wrap::wrap() is a very simple paragraph formatter.  It formats a
  86. single paragraph at a time by breaking lines at word boundries.
  87. Indentation is controlled for the first line ($initial_tab) and
  88. all subsquent lines ($subsequent_tab) independently.  $Text::Wrap::columns
  89. should be set to the full width of your output device.
  90.  
  91. =head1 EXAMPLE
  92.  
  93.     print wrap("\t","","This is a bit of text that forms 
  94.         a normal book-style paragraph");
  95.  
  96. =head1 BUGS
  97.  
  98. It's not clear what the correct behavior should be when Wrap() is
  99. presented with a word that is longer than a line.  The previous 
  100. behavior was to die.  Now the word is split at line-length.
  101.  
  102. =head1 AUTHOR
  103.  
  104. David Muir Sharnoff <muir@idiom.com> with help from Tim Pierce and
  105. others.
  106.  
  107. =cut
  108.  
  109. Latest change by Andreas Koenig <k@anna.in-berlin.de> - 1/17/97
  110.  
  111.     print fill($initial_tab, $subsequent_tab, @text);
  112.  
  113.     print fill("", "", `cat book`);
  114.  
  115. Text::Wrap::fill() is a simple multi-paragraph formatter.  It formats
  116. each paragraph separately and then joins them together when it's done.  It
  117. will destory any whitespace in the original text.  It breaks text into
  118. paragraphs by looking for whitespace after a newline.  In other respects
  119. it acts like wrap().
  120.  
  121.  
  122. sub fill 
  123. {
  124.     my ($ip, $xp, @raw) = @_;
  125.     my @para;
  126.     my $pp;
  127.  
  128.     for $pp (split(/\n\s+/, join("\n",@raw))) {
  129.         $pp =~ s/\s+/ /g;
  130.         my $x = wrap($ip, $xp, $pp);
  131.         push(@para, $x);
  132.     }
  133.  
  134.  
  135.     return join ($ip eq $xp ? "\n\n" : "\n", @para);
  136. }
  137.  
  138.